Just Call Me Internet/Just Call Me Internet.iso/prog/atari/m2/cat3src/magic/i/mtdir.i

Modula Implementation | 1997-10-26 | 11.5 KB | 367 lines

(*----------------------------------------------------------------------*
 *                                                                      *
 *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
 *               ÿ         ÿ            ÿ    ÿ          ÿ               *
 *----------------------------------------------------------------------*
 * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
 *----------------------------------------------------------------------*
 *            Dieses Modul ist urheberrechtlich geschtzt.              *
 *                                                                      *
 * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
 * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
 * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
 * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
 * Einverst„ndnisserkl„rung des Autors.                                 *
 *                                                                      *
 * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
 * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
 * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
 * widerrufen.                                                          *
 *----------------------------------------------------------------------*)

IMPLEMENTATION MODULE mtDir;

(*----------------------------------------------------------------------*
 * Int. Vers | Datum    | Name | Žnderung                               *
 *-----------+----------+------+----------------------------------------*
 *  3.00     | 18.01.92 |  Hp  |                                        *
 *-----------+----------+------+----------------------------------------*)



(* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
(*                                              *)
(*$R-   Range-Checks                            *)
(*$S-   Stack-Check                             *)
(*                                              *)
(*----------------------------------------------*)






FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
                        Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
                        Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
                        sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
                        CastToChar, CastToByte, CastToByteset, CastToInt,
                        CastToCard, CastToBitset, CastToWord, CastToLInt,
                        CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
                        TosVersion, Accessory, Basepage, SysHeader, TosDate;






FROM SYSTEM       IMPORT  ADR, ADDRESS;
FROM MagicStrings IMPORT  Append, Assign, Length, Copy, Equal, Insert, Pos;
                  IMPORT  MagicAES, MagicVDI, MagicDOS, MagicTypes;
                  IMPORT  XBRA, MagicCookie;

CONST   NullChar =      0C;

VAR     version:        sCARDINAL;
        slash:          ARRAY [0..0] OF CHAR;
        exselector:     BOOLEAN;
        stack:          ADDRESS;

VAR     Search:         RECORD
                         name:  ARRAY [0..255] OF CHAR;
                         attr:  sBITSET;
                         first: BOOLEAN;
                         dta:   MagicDOS.PtrDTA;
                        END;

VAR     defDTA:         MagicDOS.DTA;
        defDtaPtr:      MagicDOS.PtrDTA;


PROCEDURE GetDir (VAR pfad, name: ARRAY OF CHAR; REF msg: ARRAY OF CHAR): BOOLEAN;
VAR c: sCARDINAL;
    m: ARRAY [0..30] OF CHAR;
    b: BOOLEAN;
BEGIN
 GetPath (pfad);
 IF exselector THEN
  Assign (msg, m);  m[30]:= NullChar;
  b:= MagicAES.FselExinput(m, pfad, name);
 ELSE (* Normalen Selector verwenden *)
  b:= MagicAES.FselInput (pfad, name);
 END;
 IF NOT b  THEN  Assign ('', name);  END;
 RETURN b;
END GetDir;

PROCEDURE GetFile (REF wild, message: ARRAY OF CHAR; VAR file: ARRAY OF CHAR): BOOLEAN;
VAR p: ARRAY [0..255] OF CHAR;
    n: ARRAY [0..15] OF CHAR;
BEGIN
 Assign (wild, p);  n:= '';
 IF GetDir (p, n, message) THEN
  Assign (p, file);  DelTail (file);  Append (n, file);
  RETURN TRUE;
 ELSE
  RETURN FALSE;
 END;
END GetFile;

PROCEDURE GetPath (VAR pfad: ARRAY OF CHAR);
VAR drive, c, d: sCARDINAL;
    p, suff:     ARRAY [0..40] OF CHAR;
BEGIN
 IF (pfad[0] = NullChar) OR (pfad[0] = '*') THEN
  c:= Length (pfad);
  IF c > 0 THEN
   DEC (c);
   WHILE (c > 0) & (pfad[c] # '.') DO  DEC (c);  END;
   IF c > 0 THEN
    d:= c;
    WHILE (pfad[c] # NullChar) DO
     suff [c - d]:= pfad[c];  INC (c);
    END (* WHILE *);
    suff[c - d]:= NullChar;
   END (* IF *);
  ELSE
   suff[0]:= NullChar;
  END (* IF *);
  drive:= MagicDOS.Dgetdrv ();
  Assign ('', p);
  pfad[0]:= CHR (ORD ('A') + drive);
  pfad[1]:= ':';  pfad[2]:= NullChar;
  MagicDOS.Dgetpath (p, drive + 1);
  Append (p, pfad);
  Append ('\*', pfad);
  IF suff[0] # NullChar THEN
   Append (suff, pfad)
  ELSE
   Append ('.*', pfad);
  END (* IF kein alter Suffix *);
 END (* IF pf leer *);
END GetPath;

PROCEDURE DelTail (VAR s: ARRAY OF CHAR);
VAR c: CARDINAL;
BEGIN
 c:= Length (s);
 WHILE (c > 0) & (s [c - 1] # '\') DO
  DEC (c);  s[c]:= NullChar;
 END (* WHILE *);
END DelTail;

PROCEDURE SplitPath (REF path: ARRAY OF CHAR; VAR pfad, name, suff: ARRAY OF CHAR);
VAR c, d, len, pLen:  CARDINAL;
BEGIN
 len:= Length (path);
 IF len = 0 THEN  RETURN;  END;
 pfad[0]:= NullChar;
 name[0]:= NullChar;
 suff[0]:= NullChar;
 c:= len;

 (* Suffix abspalten wenn vorhanden: *)
 IF c > 0 THEN
  DEC (c); (* Index des letzten Zeichens *)
  WHILE (c > 0) & (path[c] # '.') DO  DEC (c);  END;
  IF c > 0 THEN (* wir haben den Punkt gefunden *)
   d:= 0;
   INC (c);
   WHILE (path[c] # NullChar) AND (d < 3) DO
    suff[d]:= path[c];  INC (c);  INC (d);
   END (* WHILE *);
   IF d <= HIGH (suff) THEN  suff[d]:= NullChar  END;
  END (* IF *);
 ELSE
  suff[0]:= NullChar
 END (* IF *);

 c:= len;
 IF c > 0 THEN DEC (c); END;

 (* Dateinamen abspalten: *)
 WHILE (c > 0) & (path[c] # '\') & (path[c] # ':') DO  DEC (c);  END;
 IF (path[c] = '\') OR (path[c] = ':') THEN INC (c); END;
 pLen:= c;
 d:= 0;
 FOR c:= c TO len - 1 DO  name[d]:= path[c];  INC (d);  END;
 IF d <= HIGH (name) THEN  name[d]:= NullChar;  END;

 (* Pfad kopieren: *)
 IF pLen > 0 THEN
  FOR d:= 0 TO pLen - 1 DO  pfad[d]:= path[d];  END;
 END (* IF *);
 pfad[pLen]:= NullChar;

END SplitPath;

PROCEDURE CompletePath (VAR pfad: ARRAY OF CHAR; REF standard: ARRAY OF CHAR);
VAR drv, old: sCARDINAL;
    dummy:    lBITSET;
    drvStr:   ARRAY [0..1] OF CHAR;
    path:     ARRAY [0..255] OF CHAR;
BEGIN
 IF pfad[0] = NullChar THEN
  (* Pfad leer, dann Standard-Pfad verwenden *)
  Assign (standard, pfad)
 ELSIF pfad[0] = '\' THEN
  (* Root-Dir des aktuellen Laufwerks verwenden *)
  drvStr:= ' :';
  drv:= MagicDOS.Dgetdrv ();
  drvStr[0]:= CHR (drv + 65);
  Insert (drvStr, pfad, 0);
 ELSIF pfad[1] = ':' THEN
  (* Laufwerksbezeichner im Pfad *)
  IF pfad[2] # '\' THEN (* Standardpfad des Laufwerks verwenden *)
   old:= MagicDOS.Dgetdrv ();
   drv:= ORD (pfad[0]) - 65;
   MagicDOS.Dsetdrv (drv, dummy);
   MagicDOS.Dgetpath (path, 0);
   MagicDOS.Dsetdrv (old, dummy);
   drvStr[0]:= pfad[0];
   drvStr[1]:= pfad[1];
   Insert (drvStr, path, 0);
   Assign (path, pfad);
   Append (slash, pfad);
  END;
 ELSIF Pos (slash, pfad, 0, FALSE) < HIGH (pfad) THEN
  Insert (standard, pfad, 0);
 END;
END CompletePath;

PROCEDURE GetVersion (): sCARDINAL;
BEGIN
 RETURN version;
END GetVersion;

PROCEDURE ExSelector (): BOOLEAN;
BEGIN
 RETURN exselector;
END ExSelector;

PROCEDURE SearchParas (REF maske: ARRAY OF CHAR; attribut: sBITSET;
                       ptr: MagicDOS.PtrDTA; firsttime: BOOLEAN);
BEGIN
 WITH Search DO
  Assign (maske, name);
  attr:= attribut;
  first:= firsttime;
  dta:= ptr;
 END;
END SearchParas;

PROCEDURE Found (): BOOLEAN;
VAR err: sINTEGER;
BEGIN
 MagicDOS.Fsetdta (Search.dta);
 IF Search.first THEN
  err:= MagicDOS.Fsfirst (Search.name, Search.attr);
  Search.first:= FALSE;
 ELSE
  err:= MagicDOS.Fsnext ();
 END;
 RETURN (err = 0);
END Found;

PROCEDURE Exist (REF datei: ARRAY OF CHAR): BOOLEAN;
(* Testet, ob Datei oder Ordner schon existiert *)
VAR err: sINTEGER;
BEGIN
 MagicDOS.Fsetdta (defDtaPtr);
 RETURN MagicDOS.Fsfirst (datei, {0..15}) = 0;
END Exist;

PROCEDURE Replace (REF oldName, wildcard: ARRAY OF CHAR; VAR new: ARRAY OF CHAR);
(* Bildet aus wildcard und oldName einen neuen Dateinamen (new). *)
CONST cMaxLen =  11;
      cPrefLen =  8;

 PROCEDURE MakeMask (REF wild: ARRAY OF CHAR; VAR maske: ARRAY OF CHAR);
 (* Expandiert einen Dateinamen auf 12 Zeichen, ? und * werden als ?
  * eingetragen. Nichtvorhandene Zeichen werden Blanks!
  *)
 VAR c, d, i:   CARDINAL;
 BEGIN (* MachMaske *)
  c:= 0;  d:= 0;  Assign ("????????????", maske); (* Vorgefertigte Maske *)
  LOOP
   IF (wild[d] = CHR(0)) OR (d > HIGH(wild)) THEN
    (* Wildcard zu Ende, Rest der Maske mit Blanks auffllen *)
    FOR i:= c TO cMaxLen DO maske[i]:= " "; END;
    RETURN;
   ELSIF (wild[d] = "*") THEN
    (* Auf einen * muž ein Punkt in der Wildcard folgen! *E*.MOD ist illegal! *)
    INC(d, 2); (* Punkt auslassen *)
    EXIT; (* Fertig mit Prefix-Teil *)
   ELSIF (wild[d] = ".") THEN
    (* Punkt gefunden, Prefix bis zur Maximalen L„nge mit Blanks auffllen *)
    FOR i:= c TO cPrefLen DO  maske[i]:= " ";  END;
    INC(d);
    EXIT; (* Fertig mit Prefix-Teil *)
   ELSE (* Zeichen aus wild nach maske bertragen *)
    maske[c]:= wild[d];  INC(c);  INC(d);
   END;
  END;
  c:= cPrefLen + 1; (* Index von maske auf "nach dem Punkt" einstellen *)
  LOOP
   IF (wild[d] = CHR(0)) OR (d > HIGH(wild)) THEN
    (* Wildcard zu Ende, Rest der Maske mit Blanks auffllen *)
    FOR i:= c TO cMaxLen DO maske[i]:= " "; END;
    RETURN;
   END;
   IF (c > cMaxLen) OR (wild[d]="*") THEN
    EXIT (* wild fertig, bzw. maske voll *)
   END;
   (* Zeichen aus wild nach maske bertragen *)
   maske[c]:= wild[d];  INC(c); INC(d);
  END;
 END MakeMask;


VAR c, d: sCARDINAL;
    wild, maske: ARRAY [0..11] OF CHAR;

BEGIN (* Ersetze *)
 MakeMask (wildcard, wild); (* Masken erstellen *)
 MakeMask (oldName, maske);
 (* Alle legalen Zeichen aus wild nach maske bertragen (auch Blanks!) *)
 FOR c:= 0 TO cMaxLen DO
  IF wild[c] # "?" THEN maske[c]:= wild[c] END;
 END;
 (* new zur Sicherheit l”schen *)
 FOR c:= 0 TO cMaxLen DO new[c]:= CHR(0);  END;
 c:= 0;  d:= 0;
 LOOP
  IF (d > cMaxLen) THEN EXIT END; (* Neuer Name fertig *)
  IF d = cPrefLen THEN (* Punktposition, Punkt in new einsetzen *)
   new[c]:= ".";  INC(c);  INC(d);
  END;
  IF (maske[d] # "?") AND (maske[d] # " ") THEN
   (* Blanks und ? aussparen, haben nix im neuen Namen zu suchen! *)
   new[c]:= maske[d];  INC(c); INC(d);
  ELSE
   INC(d);
  END;
 END;
 IF c < HIGH (new) THEN new[c]:= NullChar;  END;
END Replace;

CONST   GEMtrap = 88H;
        Kennung = 'FSmp';

VAR     c:      sCARDINAL;
        adr:    ADDRESS;
        val:    lWORD;

BEGIN
 slash[0]:= '\';
 exselector:= FALSE;
 defDtaPtr:= ADR(defDTA);
 exselector:= MagicCookie.FindCookie ('FSEL', val);
 IF NOT exselector THEN
  exselector:= XBRA.Installed (Kennung, GEMtrap, adr);
 END;
 version:= TosVersion();
 IF NOT exselector THEN  exselector:= version > Tos102;  END;
END mtDir.